home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / FGFDEMO.ZIP / FGFDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-17  |  18KB  |  646 lines
  1. {*****************************************************************************
  2. *                                                                            *
  3. *  FGFDEMO.PAS                                                               *
  4. *                                                                            *
  5. *  This program demonstrates some features of Fastgraph/Fonts.               *
  6. *                                                                            *
  7. *  Fastgraph/Fonts lets you easily add bit-mapped font support to Fastgraph  *
  8. *  or Fastgraph/Light applications.                                          *
  9. *                                                                            *
  10. *  Copyright (c) 1992-1993 Ted Gruber Software.  All Rights Reserved.        *
  11. *                                                                            *
  12. *                                                                            *
  13. *  Ted Gruber Software would like to acknowledge the contributions made by   *
  14. *  Randall Dryburgh of Micron Software Sciences in creating FGFDEMO.  Randy  *
  15. *  developed the original versions of the functions relating to the palette  *
  16. *  fades and the digital odometer.                                           *
  17. *                                                                            *
  18. *****************************************************************************}
  19.  
  20. {$M 16384,0,16384}
  21.  
  22. program main;
  23. uses fgmain, fgmisc, fgpcx, fgf;
  24.  
  25. const
  26.  
  27.   NFONTS = 11;
  28.   NPALETTES = 16;
  29.   NSTEPS = 32;
  30.  
  31.   LEFT   = -1;
  32.   CENTER =  0;
  33.   RIGHT  =  1;
  34.   TOP    =  1;
  35.   BOTTOM = -1;
  36.  
  37.   { font names }
  38.  
  39.   fontname : array [1..NFONTS] of string = (
  40.     'Austin 36',
  41.     'Broadway 18',
  42.     'Cognac 19',
  43.     'Crystal 14',
  44.     'Crystal 26',
  45.     'Fountain 27',
  46.     'Modern 28',
  47.     'Plaza 14',
  48.     'Regal 24',
  49.     'Royal 15',
  50.     'Standard 8');
  51.  
  52. var
  53.  
  54.   { font handles }
  55.  
  56.   austin, broadway, cognac, crystal14, crystal26, fountain, modern : integer;
  57.   plaza, regal, royal, standard : integer;
  58.  
  59.   { other globals }
  60.  
  61.   clockspeed : longint;
  62.  
  63.   default_palette, new_palette, zeroes : array [1..NPALETTES*3] of shortint;
  64.   average : array [1..NPALETTES*3] of real;
  65.  
  66. {*****************************************************************************
  67. *                                                                            *
  68. *  average_palette                                                           *
  69. *                                                                            *
  70. *  Compute the palette fade increments used by fade_in and fade_out.         *
  71. *                                                                            *
  72. *****************************************************************************}
  73.  
  74. procedure average_palette;
  75.  
  76. var
  77.  
  78.   i : integer;
  79.  
  80. begin
  81.  
  82.   for i := 1 to NPALETTES*3 do
  83.     average[i] := default_palette[i] / NSTEPS;
  84.  
  85. end;
  86.  
  87. {*****************************************************************************
  88. *                                                                            *
  89. *  fade_in                                                                   *
  90. *                                                                            *
  91. *  Fade one or more DACs from black to their target colors.                  *
  92. *                                                                            *
  93. *****************************************************************************}
  94.  
  95. procedure fade_in (start, count : integer);
  96.  
  97. var
  98.  
  99.   i, j, k, n : integer;
  100.   last : integer;
  101.   factor : real;
  102.  
  103. begin
  104.  
  105.   last := start + count - 1;
  106.  
  107.   for i := 1 to NSTEPS do
  108.   begin
  109.     factor := i;
  110.     k := 1;
  111.     n := start * 3 + 1;
  112.     for j := start to last do
  113.     begin
  114.       new_palette[k] := trunc(average[n] * factor);
  115.       inc(k); inc(n);
  116.       new_palette[k] := trunc(average[n] * factor);
  117.       inc(k); inc(n);
  118.       new_palette[k] := trunc(average[n] * factor);
  119.       inc(k); inc(n);
  120.     end;
  121.     fg_setdacs(start,count,new_palette);
  122.     fg_waitfor(1);
  123.   end;
  124.  
  125. end;
  126.  
  127. {*****************************************************************************
  128. *                                                                            *
  129. *  fade_out                                                                  *
  130. *                                                                            *
  131. *  Fade one or more DACs from their current colors to black.                 *
  132. *                                                                            *
  133. *****************************************************************************}
  134.  
  135. procedure fade_out (start, count : integer);
  136.  
  137. var
  138.  
  139.   i, j, k, n : integer;
  140.   last : integer;
  141.   factor : real;
  142.  
  143. begin
  144.  
  145.   last := start + count - 1;
  146.  
  147.   for i := 1 to NSTEPS do
  148.   begin
  149.     factor := i;
  150.     k := 1;
  151.     n := start * 3 + 1;
  152.     for j := start to last do
  153.     begin
  154.       new_palette[k] := default_palette[n] - trunc(average[n] * factor);
  155.       inc(k); inc(n);
  156.       new_palette[k] := default_palette[n] - trunc(average[n] * factor);
  157.       inc(k); inc(n);
  158.       new_palette[k] := default_palette[n] - trunc(average[n] * factor);
  159.       inc(k); inc(n);
  160.     end;
  161.     fg_setdacs(start,count,new_palette);
  162.     fg_waitfor(1);
  163.   end;
  164.  
  165. end;
  166.  
  167. {*****************************************************************************
  168. *                                                                            *
  169. *  widest_numeral                                                            *
  170. *                                                                            *
  171. *  Compute the width of the widest digit in the current font.                *
  172. *                                                                            *
  173. *****************************************************************************}
  174.  
  175. function widest_numeral : integer;
  176.  
  177. var
  178.  
  179.   widest, width : integer;
  180.   c : integer;
  181.  
  182. begin
  183.  
  184.   widest := 0;
  185.   for c := ord('0') to ord('9') do
  186.   begin
  187.     width := fgf_width(chr(c),1);
  188.     if (width > widest) then widest := width;
  189.   end;
  190.  
  191.   widest_numeral := width;
  192.  
  193. end;
  194.  
  195. {*****************************************************************************
  196. *                                                                            *
  197. *  odometer                                                                  *
  198. *                                                                            *
  199. *  Increment the odometer amount by one cent and scroll its new amount on    *
  200. *  the screen.                                                               *
  201. *                                                                            *
  202. *****************************************************************************}
  203.  
  204. procedure odometer (x, y : integer; amount : real;
  205.                     foreground_color, background_color : integer);
  206.  
  207. var
  208.  
  209.   i, j : integer;
  210.   char_width : integer;
  211.   delay_diff, delay_same : integer;
  212.   height, width : integer;
  213.   length_old, length_new : integer;
  214.   xpos : integer;
  215.   amount_old, amount_new : string[8];
  216.  
  217. begin
  218.  
  219.   { create strings for old and new amounts }
  220.  
  221.   str(amount:7:2,amount_old);
  222.   str(amount+0.01:7:2,amount_new);
  223.   length_old := length(amount_old);
  224.   length_new := length(amount_new);
  225.  
  226.   { get height of the amount string }
  227.  
  228.   height := fgf_height(amount_old,length_old);
  229.  
  230.   { get its width, rounded up to a byte boundary multiple }
  231.  
  232.   width := (widest_numeral + 7) and $FFF8;
  233.  
  234.   { create a box in the background color }
  235.  
  236.   fg_setpage(1);
  237.   fg_setcolor(background_color);
  238.   fg_rect(200,200+width*length_new,100-height,100+height);
  239.   fg_setcolor(foreground_color);
  240.   fgf_justify(LEFT,BOTTOM);
  241.  
  242.   { put old amount on hidden video page }
  243.  
  244.   for i := 1 to length_old do
  245.   begin
  246.     char_width := (width - fgf_width(amount_old[i],1)) div 2;
  247.     fg_move(200+(i-1)*width+char_width,100);
  248.     fgf_print(amount_old[i],1);
  249.   end;
  250.  
  251.   { put new amount on hidden video page }
  252.  
  253.   for i := 1 to length_new do
  254.   begin
  255.     char_width := (width - fgf_width(amount_new[i],1)) div 2;
  256.     fg_move(200+(i-1)*width+char_width,100+height);
  257.     fgf_print(amount_new[i],1);
  258.   end;
  259.  
  260.   { copy old amount to visual video page }
  261.  
  262.   fg_transfer(200,200+width*length_old,100-height,100,x,y,1,0);
  263.  
  264.   { roll the odometer }
  265.  
  266.   delay_diff := (clockspeed div 60) div length_new;
  267.   delay_same := (clockspeed div 10) div length_new;
  268.  
  269.   for j := 1 to height do
  270.   begin
  271.     for i := 1 to length_new do
  272.     begin
  273.       if (amount_new[i] <> amount_old[i]) and (amount_old[i] <> '.') then
  274.       begin
  275.         fg_stall(delay_diff);
  276.         xpos := 200 + (i-1) * width;
  277.         fg_transfer(xpos,xpos+width,100+(j-1)-height,100+(j-1),x+xpos-200,y,1,0);
  278.       end
  279.       else
  280.         fg_stall(delay_same);
  281.     end;
  282.   end;
  283.  
  284. end;
  285.  
  286. {*****************************************************************************
  287. *                                                                            *
  288. *  main program                                                              *
  289. *                                                                            *
  290. *****************************************************************************}
  291.  
  292. var
  293.  
  294.   i : integer;
  295.   abort : boolean;
  296.   old_mode : integer;
  297.   status : integer;
  298.   width : integer;
  299.   x, y : integer;
  300.   amount : real;
  301.   key, aux : byte;
  302.   cc : string[1];
  303.   message : string[24];
  304.  
  305. begin
  306.  
  307.   { make sure we're running on a VGA system; exit if not }
  308.  
  309.   if (fg_testmode(18,0) = 0) then
  310.   begin
  311.     writeln('This demo requires 640 x 480 16 color VGA graphics.');
  312.     exit;
  313.   end;
  314.  
  315.   { load the font files }
  316.  
  317.   austin    := fgf_load('AUSTIN36.FGF'+chr(0));
  318.   broadway  := fgf_load('BRODWY18.FGF'+chr(0));
  319.   cognac    := fgf_load('COGNAC19.FGF'+chr(0));
  320.   crystal14 := fgf_load('CRYSTL14.FGF'+chr(0));
  321.   crystal26 := fgf_load('CRYSTL26.FGF'+chr(0));
  322.   fountain  := fgf_load('FOUNTN27.FGF'+chr(0));
  323.   modern    := fgf_load('MODERN28.FGF'+chr(0));
  324.   plaza     := fgf_load('PLAZA14.FGF'+chr(0));
  325.   regal     := fgf_load('REGAL24.FGF'+chr(0));
  326.   royal     := fgf_load('ROYAL15.FGF'+chr(0));
  327.   standard  := fgf_load('STNDRD08.FGF'+chr(0));
  328.  
  329.   { verify all fonts were loaded successfully; exit if not }
  330.  
  331.   abort := false;
  332.   if (austin = 0) then abort := true;
  333.   if (broadway = 0) then abort := true;
  334.   if (cognac = 0) then abort := true;
  335.   if (crystal14 = 0) then abort := true;
  336.   if (crystal26 = 0) then abort := true;
  337.   if (fountain = 0) then abort := true;
  338.   if (modern = 0) then abort := true;
  339.   if (plaza = 0) then abort := true;
  340.   if (regal = 0) then abort := true;
  341.   if (royal = 0) then abort := true;
  342.   if (standard = 0) then abort := true;
  343.   if (abort) then
  344.   begin
  345.      writeln('Failure loading one or more font files.');
  346.      exit;
  347.   end;
  348.  
  349.   { benchmark the system speed }
  350.  
  351.   clockspeed := fg_measure;
  352.  
  353.   { initialize the array that zeroes the DAC values }
  354.  
  355.   for i := 1 to NPALETTES*3 do
  356.     zeroes[i] := 0;
  357.  
  358.   { initialize Fastgraph's video environment }
  359.  
  360.   old_mode := fg_getmode;
  361.   fg_setmode(18);
  362.   fg_getdacs(0,NPALETTES,default_palette);
  363.  
  364.   { create palette increment averages }
  365.  
  366.   average_palette;
  367.  
  368.   { draw the TGS logo on the hidden page }
  369.  
  370.   fg_setpage(1);
  371.   status := fg_showpcx('TGS.PCX'+chr(0),0);
  372.  
  373.   { fade in the TGS logo on the visual page }
  374.  
  375.   fg_setdacs(0,NPALETTES,zeroes);
  376.   fg_transfer(0,185,0,89,227,285,1,0);
  377.   fade_in(0,16);
  378.  
  379.   { fade in "and" }
  380.  
  381.   fg_setpage(0);
  382.   fg_setrgb(15,0,0,0);
  383.   fgf_select(standard);
  384.   fg_setcolor(15);
  385.   fg_move(320,315);
  386.   fgf_justify(CENTER,CENTER);
  387.   fgf_print('and',3);
  388.   fade_in(15,1);
  389.  
  390.   { fade out the visual page }
  391.  
  392.   fg_waitfor(30);
  393.   fade_out(0,16);
  394.  
  395.   { erase both pages }
  396.  
  397.   fg_setpage(0);
  398.   fg_erase;
  399.   fg_setpage(1);
  400.   fg_erase;
  401.  
  402.   { draw the Micron logo on the hidden page }
  403.  
  404.   fg_move(0,0);
  405.   status := fg_showpcx('MICRON.PCX'+chr(0),2);
  406.  
  407.   { fade in the Micron logo on the visual page }
  408.  
  409.   fg_setdacs(0,NPALETTES,zeroes);
  410.   fg_transfer(0,165,0,52,237,266,1,0);
  411.   fade_in(0,16);
  412.  
  413.   { fade in "present" }
  414.  
  415.   fg_setpage(0);
  416.   fg_setrgb(14,0,0,0);
  417.   fg_setcolor(14);
  418.   fg_move(320,315);
  419.   fgf_print('present',7);
  420.   fade_in(14,1);
  421.  
  422.   { fade to black }
  423.  
  424.   fg_waitfor(30);
  425.   fade_out(0,16);
  426.  
  427.   { erase both pages }
  428.  
  429.   fg_setpage(0);
  430.   fg_erase;
  431.   fg_setpage(1);
  432.   fg_erase;
  433.  
  434.   { display and then fade out the Fastgraph/Fonts logo }
  435.  
  436.   fg_setpage(0);
  437.   fgf_select(austin);
  438.   fg_setcolor(10);
  439.   fg_move(320,240);
  440.   fgf_justify(CENTER,BOTTOM);
  441.   fgf_print('Fastgraph/Fonts',15);
  442.   fgf_select(crystal14);
  443.   fg_setcolor(15);
  444.   fg_move(320,270);
  445.   fgf_justify(CENTER,CENTER);
  446.   fgf_print('Copyright (c) 1992-1993 Ted Gruber Software',43);
  447.   fg_move(320,286);
  448.   fgf_print('All Rights Reserved.',20);
  449.   fade_in(10,1);
  450.   fg_waitfor(18);
  451.   fade_in(15,1);
  452.   fg_waitfor(30);
  453.   fade_out(0,16);
  454.  
  455.   { display the info screen }
  456.  
  457.   fg_setpage(0);
  458.   fg_erase;
  459.  
  460.   fgf_select(regal);
  461.   fg_setcolor(10);
  462.   fg_box(0,639,0,479);
  463.   fg_move(0,32);
  464.   fg_draw(639,32);
  465.   fg_move(320,5);
  466.   fgf_justify(CENTER,TOP);
  467.   fgf_print('Fastgraph/Fonts',15);
  468.  
  469.   fgf_select(modern);
  470.   fg_setcolor(12);
  471.   fg_move(320,60);
  472.   fgf_justify(CENTER,CENTER);
  473.   fgf_print('Fastgraph/Fonts'+chr(127)+chr(9)+' lets you easily add bit-mapped',48);
  474.   fg_move(320,90);
  475.   fgf_print('character support to Fastgraph applications.  It',48);
  476.   fg_move(320,120);
  477.   fgf_print('includes a wide range of fonts in several point sizes.',54);
  478.   fg_move(320,150);
  479.   fgf_print('An application can load up to 32 fonts at once.',47);
  480.  
  481.   fgf_select(broadway);
  482.   fg_setcolor(12);
  483.   fg_move(320,190);
  484.   fgf_print('Fastgraph/Fonts'+chr(127)+chr(15)+' includes functions for font loading',53);
  485.   fg_move(320,215);
  486.   fgf_print('and unloading, string display with horizontal and',49);
  487.   fg_move(320,240);
  488.   fgf_print('vertical justification, font selection, determining',51);
  489.   fg_move(320,265);
  490.   fgf_print('string height and width, and other useful features.',51);
  491.   fg_move(320,290);
  492.   fgf_print('Font files that come with Fastgraph/Fonts may be',48);
  493.   fg_move(320,315);
  494.   fgf_print('distributed freely as part of your applications.',48);
  495.  
  496.   fgf_select(fountain);
  497.   fg_setcolor(9);
  498.   fg_move(320,355);
  499.   fgf_print('The '+chr(127)+chr(12)+'Fastgraph/Fonts User''s Guide'+chr(127)+chr(9)+' includes a',47);
  500.   fg_move(320,385);
  501.   fgf_print('description of the font file format, so you can',47);
  502.   fg_move(320,415);
  503.   fgf_print('create your own font files in case Fastgraph/Fonts',50);
  504.   fg_move(320,445);
  505.   fgf_print('doesn''t include your favorite fonts.',36);
  506.  
  507.   fade_in(0,16);
  508.   fg_waitkey;
  509.   fade_out(0,16);
  510.   fg_erase;
  511.  
  512.   { display the features screen }
  513.  
  514.   fgf_select(cognac);
  515.   fg_setcolor(14);
  516.   fg_move(320,240);
  517.   fgf_print('...and now to demonstrate some Fastgraph/Fonts features...',58);
  518.   fade_in(14,1);
  519.   fg_waitfor(30);
  520.   fade_out(14,1);
  521.   fg_setcolor(1);
  522.   fg_setpage(1);
  523.   fg_rect(0,639,0,319);
  524.   fg_setpage(0);
  525.   fg_rect(0,639,0,479);
  526.   fg_setdacs(0,NPALETTES,default_palette);
  527.  
  528.   fgf_select(crystal26);
  529.   fg_setcolor(15);
  530.   fg_move(320,50);
  531.   fgf_justify(CENTER,BOTTOM);
  532.   fgf_print('Load up to 32 fonts at once!',28);
  533.  
  534.   fgf_select(crystal26);
  535.   fg_setcolor(4);
  536.   fg_move(240,90);
  537.   fgf_print('Jackpot is $ ',13);
  538.   x := fg_getxpos;
  539.   y := fg_getypos;
  540.  
  541.   fgf_select(broadway);
  542.   fg_setcolor(2);
  543.   fg_move(320,120);
  544.   cc := chr(127);
  545.   fgf_print('Change '+cc+chr(3)+'colors '+cc+chr(4)+'anywhere '+cc+chr(5)+'in '+cc+chr(6)+'a '+cc+chr(7)+'string',44);
  546.  
  547.   fgf_select(royal);
  548.   fg_setcolor(14);
  549.   fg_move(320,160);
  550.   fgf_print('Justify strings horizontally and vertically:',44);
  551.   fg_setcolor(7);
  552.   fg_move(0,180);
  553.   fg_dash(639,180,$1111);
  554.   fg_setcolor(14);
  555.   fg_move(0,180);
  556.   fgf_justify(LEFT,BOTTOM);
  557.   fgf_print('LEFT AND ABOVE',14);
  558.   fg_move(320,180);
  559.   fgf_justify(CENTER,CENTER);
  560.   fgf_print('CENTERED BOTH DIRECTIONS',24);
  561.   fg_move(639,180);
  562.   fgf_justify(RIGHT,TOP);
  563.   fgf_print('RIGHT AND BELOW',15);
  564.  
  565.   fgf_select(modern);
  566.   fg_setcolor(12);
  567.   fg_move(320,220);
  568.   width := fgf_width(' ',1);
  569.   fgf_space(width div 2);
  570.   fgf_justify(CENTER,CENTER);
  571.   fgf_print('narrow spacing between words',28);
  572.   fg_move(320,250);
  573.   fgf_space(width);
  574.   fgf_print('normal spacing between words',28);
  575.   fg_move(320,280);
  576.   fgf_space(width*2);
  577.   fgf_print('wide spacing between words',26);
  578.  
  579.   repeat
  580.      fg_intkey(key,aux);
  581.   until (key+aux = 0);
  582.  
  583.   fgf_select(crystal26);
  584.   fg_setcolor(4);
  585.   amount := 1998.31;
  586.   repeat
  587.   begin
  588.     odometer(x,y,amount,4,1);
  589.     amount := amount + 0.01;
  590.     fg_intkey(key,aux);
  591.   end;
  592.   until (key+aux > 0) or (amount >= 10000.00);
  593.  
  594.   { cast of characters screen }
  595.  
  596.   fg_setpage(0);
  597.   fg_erase;
  598.   fgf_select(regal);
  599.   fg_setcolor(10);
  600.   fg_move(320,0);
  601.   fgf_justify(CENTER,TOP);
  602.   fgf_print('*** Partial Cast of Characters ***',34);
  603.  
  604.   message := 'ABCDabcd1234.,?!+-&@#$';
  605.   y := 80;
  606.  
  607.   for i := 1 to NFONTS do
  608.   begin
  609.     fgf_select(i);
  610.     fg_setcolor(i);
  611.     fg_move(20,y);
  612.     fgf_justify(LEFT,BOTTOM);
  613.     fgf_print(fontname[i],length(fontname[i]));
  614.     fg_move(620,y);
  615.     fgf_justify(RIGHT,BOTTOM);
  616.     fgf_print(message,22);
  617.     y := y + 36;
  618.   end;
  619.  
  620.   fg_setcolor(10);
  621.   fg_move(320,y);
  622.   fgf_justify(CENTER,BOTTOM);
  623.   fgf_print('and many more!',14);
  624.  
  625.   fg_waitkey;
  626.   fade_out(0,16);
  627.  
  628.   { unload fonts and restore the original video state before exiting }
  629.  
  630.   fgf_unload(-1);
  631.   fg_setmode(old_mode);
  632.   fg_reset;
  633.  
  634.   { display ordering information }
  635.  
  636.   writeln('Fastgraph/Fonts (tm) is available for $49 from:');
  637.   writeln;
  638.   writeln('Ted Gruber Software     orders/info (702) 735-1980');
  639.   writeln('PO Box 13408                    FAX (702) 735-4603');
  640.   writeln('Las Vegas, NV  89112            BBS (702) 796-7134');
  641.   writeln;
  642.   writeln('Please add $3 shipping within the U.S. and Canada,');
  643.   writeln('or $6 to other countries.');
  644.  
  645. end.
  646.